perm filename NET.BBN[1,LMM] blob
sn#029054 filedate 1973-03-14 generic text, type T, neo UTF8
(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
T)
(LISPXPRIN1 (QUOTE "21-JAN-73 15:46:16")
T)
(LISPXTERPRI T))
(DEFINEQ
(PUSH
[LAMBDA (XFILE)
(ONEFTP XFILE (QUOTE STOR])
(PULL
[LAMBDA (XFILE)
(ONEFTP XFILE (QUOTE RETR])
(ONEFTP
[LAMBDA (XFILE COM)
(PROG ((POS (STRPOS (QUOTE :)
XFILE))
POS1 HOST FILE LFILE PAIR USER)
[SETQ HOST (MKATOM (SUBSTRING XFILE 1 (SUB1 POS]
[SETQ LFILE (SETQ FILE (MKATOM (SUBSTRING XFILE (ADD1 POS)
-1]
[SETQ USER
(MKATOM (COND
((STRPOS (QUOTE <)
FILE NIL NIL T)
[SETQ LFILE
(MKATOM (SUBSTRING
FILE
(ADD1 (SETQ POS1
(STRPOS (QUOTE >)
FILE]
(SUBSTRING FILE 2 (SUB1 POS1)))
(T (USERNAME]
[OR (SETQ PAIR (FTPOPEN HOST))
(ERROR (QUOTE (COULD NOT PERFORM ICP]
(FTPUSER PAIR USER (OR (PASSWORD USER HOST)
(ASKPASS USER HOST)))
(OR (FTPXFER PAIR COM FILE LFILE)
(PRINT (QUOTE (COULD NOT PERFORM TRANSFER))
T))
(FTPCLOSE PAIR])
(WAITEOF
[LAMBDA (FILE)
(ASSEMBLE NIL
(CQ (VAG (OPNJFN FILE)))
(PUSH NP , 1)
LP (MOVE 1 , 0 (NP))
(JSYS 20)
(TLNE 2 , 512)
(JRST OUT)
(MOVEI 1 , 1000)
(JSYS 119)
(JRST LP)
OUT)
NIL])
(FTPXFER
[LAMBDA (PAIR COM FFILE LFILE) (* E (RADIX
777777777770Q))
(PROG (FORK FILE IN)
(SELECTQ COM
[RETR (OR (SETQ FILE (NETOPENF (NETFNAME 6)
440000200000Q))
(RETURN NIL))
(SETQ FORK (FORKCOPY (SETQ IN FILE)
(OPENF LFILE 440000100000Q
]
(STOR (OR (SETQ FILE (NETOPENF (NETFNAME 7)
440000100000Q))
(RETURN NIL))
(SETQ FORK (FORKCOPY (SETQ
IN (OPENF LFILE
440000200000Q))
FILE)))
(HELP))
(FTPREPLY PAIR)
(FTPCOM COM FFILE PAIR)
(FTPREPLY PAIR)
(WAITEOF IN)
(KFORK FORK)
(CLOSEF FILE)
(CLOSEF LFILE)
(RETURN T) (* E (RADIX 10))
])
(FTPOPEN
[LAMBDA (FHOST)
(PROG ((PAIR (NETICP 2 FHOST 3)))
(COND
((NULL PAIR)
(RETURN NIL)))
(FTPCOM (QUOTE BYTE)
36 PAIR)
(FTPCOM (QUOTE TYPE)
(QUOTE I)
PAIR)
(RETURN PAIR])
(FTPUSER
[LAMBDA (PAIR USER PASS)
(PROG (ACCT)
[COND
((LISTP PASS)
(SETQ ACCT (CADR PASS))
(SETQ PASS (CAR PASS]
(FTPCOM (QUOTE USER)
USER PAIR)
(FTPCOM (QUOTE PASS)
PASS PAIR)
(COND
(ACCT (FTPCOM (QUOTE ACCT)
ACCT PAIR])
(HOSTFIELD
[LAMBDA (FILE)
(PROG ((POS 1))
LP (SETQ POS (OR (STRPOS (QUOTE -)
FILE POS NIL NIL T)
(GO OUT)))
(GO LP)
OUT (RETURN (MKATOM (SUBSTRING FILE (STRPOS (QUOTE %.)
FILE NIL NIL NIL T)
(IPLUS POS -2])
(FTPCLOSE
[LAMBDA (PAIR)
(FTPCOM (QUOTE BYE)
NIL PAIR)
(FTPREPLY PAIR)
(CLOSEF (CAR PAIR))
(CLOSEF (CDR PAIR])
(PASSWORD
[LAMBDA (USER HOST)
(PROG [(FILE (PACK (LIST (QUOTE <)
USER
(QUOTE >WORDS.LISP]
(RETURN (COND
((INFILEP FILE)
(INFILE FILE)
(INPUT T)
(PROG1 (CDR (SASSOC HOST (READ FILE)))
(CLOSEF FILE])
(ASKPASS
[LAMBDA (USER HOST)
(PRIN1 (QUOTE PASS/ACCT% )
T)
(COND
((NEQ (MKATOM USER)
(MKATOM (USERNAME)))
(PRIN1 (QUOTE FOR% )
T)
(PRIN1 USER T)))
(PRIN1 (QUOTE @)
T)
(PRIN1 HOST T)
(PRIN1 (QUOTE :% )
T)
(READ T])
(NETOPENTEST
[LAMBDA NIL
(PROG ((FILE (CADR ERRORMESS)))
[COND
((NUMBERP FILE)
(SETQ FILE (JFNS FILE]
(COND
((STRPOS (QUOTE NET:)
(CADR ERRORMESS)
NIL NIL T)
(PRIN1 (QUOTE "Could not open ")
T)
(PRINT (CADR ERRORMESS)
T)
(RETFROM ERRORPOS NIL])
(TRAPERROR
[LAMBDA (N FORM)
(RPLACD [OR (ASSOC N ERRORTYPELST)
(CAR (SETQ ERRORTYPELST (CONS (LIST N)
ERRORTYPELST]
(LIST FORM])
(OPENPAIR
[LAMBDA (LSOCK FHOST FSOCK SIZE)
(PROG ((INF (NETFNAME LSOCK FHOST (ADD1 FSOCK)))
(OUTF (NETFNAME (ADD1 LSOCK)
FHOST FSOCK)))
(RETURN (COND
([AND (SETQ INF (NETOPENF INF (LOGOR (LLSH SIZE 30)
65536)))
(SETQ OUTF (NETOPENF OUTF
(LOGOR (LLSH SIZE 30)
32768]
(CONS INF OUTF))
(T (COND
(INF (CLOSEF INF)))
NIL])
(NETOPENF
[LAMBDA (FILE MODE)
(PROG ((JFN (GTJFN FILE)))
(COND
((NULL JFN)
(RETURN NIL)))
(RETURN (COND
((TIMESET (QUOTE (OPENF JFN MODE))
20000)
FILE)
(T (PRIN1 (QUOTE "Timeout trying to open ")
T)
(PRINT FILE T)
(RLJFN JFN)
NIL])
(CCFORK
[LAMBDA NIL
(PROG ((FORK (CFORK)))
(SHAREPAGE (RSH PROGPAGE 9)
FORK)
(SFACS FORK FORKACS)
(RETURN FORK])
(TIMESET
[LAMBDA (TIMEX TIMEMS TIMEFORK)
(PROG (TIMEV)
(SETQ TIMEFORK (STARTTIMER TIMEMS))
(SETQ TIMEV (LIST (EVAL TIMEX)))
(KFORK TIMEFORK)
(RETURN TIMEV])
(NETBREAKTEST
[LAMBDA NIL
(PROG ((POS (STKPOS (QUOTE TIMESET)
1)))
(COND
(POS (KFORK (EVALV (QUOTE TIMEFORK)
POS))
(RETFROM POS NIL)))
(RETURN NIL])
(STARTTIMER
[LAMBDA (MS)
(SETA FORKACS 2 MS)
(PROG ((TIMER (CCFORK)))
(SFORK TIMER TIMERSTART)
(RETURN TIMER])
(FORKCOPY
[LAMBDA (FROM TO TEXT)
(SETA FORKACS 5 (OR (NUMBERP FROM)
(OPNJFN FROM)))
(SETA FORKACS 6 (OR (NUMBERP TO)
(OPNJFN TO)))
(SETA FORKACS 7 (COND
(TEXT 1)
(T 0)))
(PROG ((FORK (CCFORK)))
(SFORK FORK COPYSTART)
(RETURN FORK])
(TELNET
[LAMBDA (HOST SOCK)
(PROG [(PAIR (NETICP 2 HOST (OR SOCK 1]
(COND
((NULL PAIR)
(RETURN NIL)))
(ERSETQ (TELLOOP (CAR PAIR)
(CDR PAIR)))
(CLOSEF (CAR PAIR))
(CLOSEF (CDR PAIR))
(RETURN T])
(TELLOOP
[LAMBDA (NETIN NETOUT)
(PROG ((F1 (FORKCOPY NETIN 65))
(F2 (FORKCOPY 64 NETOUT T)))
(ERSETQ (PROG NIL
LP (DISMISS 100000)
(GO LP)))
(KFORK F1)
(KFORK F2])
(NETICP
[LAMBDA (LSOCK FHOST FSOCK) (* E (RADIX
777777777770Q))
(PROG ((FILE (NETOPENF (NETFNAME LSOCK FHOST FSOCK)
400000200000Q))
S PAIR)
(COND
((NULL FILE)
(RETURN NIL)))
(SETQ S (BIN FILE))
(CLOSEF FILE)
(COND
((SETQ PAIR (OPENPAIR (IPLUS LSOCK 2)
FHOST S 10Q))
(PRINT (QUOTE ICP)
T)))
(RETURN PAIR) (* E (RADIX 10))
])
(NETFNAME
[LAMBDA (LSOCK FHOST FSOCK)
(PACK (NCONC [COND
(LSOCK (LIST (QUOTE NET:)
(OCTAL LSOCK)
(QUOTE %.)))
(T (LIST (QUOTE NET:.]
[COND
((OR FHOST FSOCK)
(LIST FHOST (QUOTE -)
(OCTAL FSOCK]
(QUOTE (;T])
(FTPCOM
[LAMBDA (COM ARG PAIR)
(PRIN1 (COND
(ARG (CONCAT COM (QUOTE % )
ARG CRLF))
(T (CONCAT COM CRLF)))
(CDR PAIR])
(FTPREPLY
[LAMBDA (PAIR)
(PROG [CODE (INF (CAR PAIR))
(JFN (OPNJFN (CAR PAIR)))
(NILJFN (OPNJFN (OR (OPENP (QUOTE NIL:))
(PROGN (OUTFILE (QUOTE NIL:))
(OUTPUT T]
LP (SETQ CODE (RATOM INF))
(SELECTQ (IQUOTIENT CODE 100)
[(4 5)
(COND
((NEQ CODE 400)
(PRINT CODE T)
(COPYLINE JFN 65)
(ERROR!]
(COPYLINE JFN NILJFN))
(COND
((NEQ (RIBC INF)
0)
(GO LP])
(COPYLINE
[LAMBDA (FROM TO)
(ASSEMBLE NIL
(CQ (VAG FROM))
(PUSH NP , 1)
(CQ (VAG TO))
(PUSH NP , 1)
LP (MOVE 1 , -1 (NP))
(JSYS 40)
(MOVE 1 , 0 (NP))
(JSYS 41)
(CAIN 2 , 10)
(JRST OUT)
(CAIE 2 , 31)
(JRST LP)
OUT (SUB NP , = 524290))
NIL])
(NETSET
[LAMBDA NIL
[OR (ESQ PROGPAGE)
(SETQ PROGPAGE (LOC (SETQ PROGBLK (GETBLK 1]
(OR (ESQ FORKACS)
(SETQ FORKACS (ARRAY 16 16)))
[PROG ((PTR PROGPAGE))
(MAPC PROGNAMES
(FUNCTION (LAMBDA (X)
(SET (PACK (LIST (SUBSTRING X 1 -5)
(QUOTE START)))
PTR)
(SETQ PTR (STOREPROG (EVAL X)
PTR]
(TRAPERROR 18 (QUOTE (NETBREAKTEST)))
(TRAPERROR 9 (QUOTE (NETOPENTEST)))
(PROG [(L (SUBSET NETFNS (FUNCTION (LAMBDA (FN)
(AND (EXPRP FN)
(EQ (CAADDR (GETD FN))
(QUOTE ASSEMBLE]
(COND
(L (LISPXUNREAD (QUOTE (ST NIL)))
(COMPILE L])
(ESQ
[NLAMBDA (ERSETX ERSETFLG)
(PROG ((HELPCLOCK NIL))
(RESETVAR DWIMFLG NIL (ERRORSET ERSETX ERSETFLG])
(STOREPROG
[LAMBDA (L PTR)
(PROG ((M L)
(LC 0)
TAGS REFS INS OP AC INDEX I ADDR)
LP [COND
((NULL M)
[MAPC
REFS
(FUNCTION (LAMBDA (X)
(FRPLACA (VAG (IPLUS PTR (CDR X)))
(VAG (IPLUS PTR
(CDR (FASSOC (CAR X)
TAGS]
(RETURN (IPLUS PTR LC)))
((NLISTP (SETQ INS (CAR M)))
(SETQ TAGS (CONS (CONS INS LC)
TAGS)))
((EQ (CAR INS)
(QUOTE *)))
([NOT (NUMBERP (SETQ OP (OR (NUMBERP (CAR INS))
(GETP (CAR INS)
(QUOTE OPD]
(ERROR (QUOTE UNDEFINED%% OPCODE)
(CAR INS)))
(T (SETQ AC (SELECTQ (CADR (SETQ INS (CDR INS)))
[, (PROG1 (CAR INS)
(SETQ INS (CDDR INS]
0))
(SETQ I (SELECTQ (CAR INS)
(@ (SETQ INS (CDR INS))
4194304)
0))
(SETQ INDEX (COND
((CDR INS)
(CAADR INS))
(T 0)))
(SETQ ADDR (COND
[(NUMBERP (SETQ INS (CAR INS]
((SETQ REFS (CONS (CONS INS LC)
REFS))
0)
(T 0)))
(CLOSER (IPLUS PTR LC)
(LOGOR (LLSH OP 18)
(LLSH AC 23)
I
(LLSH INDEX 18)
ADDR))
(SETQ LC (ADD1 LC]
(SETQ M (CDR M))
(GO LP])
(OCTAL
[LAMBDA (N)
(PROG ((R (RADIX -8))
(S (MKSTRING N)))
(RADIX R)
(RETURN S])
(SHAREPAGE
[LAMBDA (PN FORK)
(ASSEMBLE NIL
(CQ (VAG PN))
(PUSH NP , 1)
(CQ (VAG FORK))
(HRLZ 2 , 1)
(POP NP , 1)
(IOR 2 , 1)
(HRLI 1 , 131072)
(MOVSI 3 , 57344)
(JSYS 46])
)
(LISPXPRINT (QUOTE NETFNS)
T)
(RPAQQ NETFNS
(PUSH PULL ONEFTP WAITEOF FTPXFER FTPOPEN FTPUSER HOSTFIELD
FTPCLOSE PASSWORD ASKPASS NETOPENTEST TRAPERROR OPENPAIR
NETOPENF CCFORK TIMESET NETBREAKTEST STARTTIMER FORKCOPY
TELNET TELLOOP NETICP NETFNAME FTPCOM FTPREPLY COPYLINE
NETSET ESQ STOREPROG OCTAL SHAREPAGE))
(LISPXPRINT (QUOTE NETVARS)
T)
[RPAQQ NETVARS (PROGNAMES (VARS * PROGNAMES)
CRLF
(P (NETSET]
(RPAQQ PROGNAMES (COPYPROG TIMERPROG))
(RPAQQ COPYPROG (LP (MOVE 1 , 4)
(JSYS 40)
(* BIN)
(MOVE 3 , 2)
(JSYS 20)
(* GTSTS)
(TLNE 2 , 512)
(* EOF)
(JSYS 120)
(* HALTF)
(MOVE 1 , 5)
(JUMPE 6 , OUT)
(CAIE 3 , 31)
(JRST OUT)
(MOVEI 2 , 10)
(JSYS 41)
(* BOUT)
(MOVEI 3 , 13)
OUT
(MOVE 2 , 3)
(JSYS 41)
(* BOUT)
(JRST LP)))
(RPAQQ TIMERPROG ((JSYS 119)
(* DISMS)
(MOVEI 1 , 64)
(MOVEI 2 , 2)
(JSYS 76)
(* STI)
(JSYS 120)
(* HALTF)))
(RPAQQ CRLF "
")
(NETSET)
STOP